Shareware Grab Bag/Shareware Grab Bag.iso/050/pc_disk.pqs/pc-disk.pas

Pascal/Delphi Source File | 1985-01-17 | 38.1 KB | 1,155 lines

Program pc_disk;
{$C-}
{ types and vars req'd for disk space and dir procedures }

Const
  blink_yes    = true;
  blink_no     = false;
  yes_no       : set of char = ['Y','y','N','n'];
  max_records  = 1000;
Type
  names        = string[80];
  regpack      = record
                   ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
                 end;
  mem_ptr      = ^pointer_type;
  pointer_type = array [1..2] of integer;
  fname_type   = string[11];
  memo_type    = string[33];
  word         = array [1..2] of char;
  cat_type     = record
                   vol_record : integer;
                   fil        : string[11];
                   sizelo     : word;
                   sizehi     : word;
                   time       : word;
                   date       : word;
                   memo       : string[33];
                 end;
  temp_type     = record
                   fil        : string[11];
                   sizelo     : word;
                   sizehi     : word;
                   time       : word;
                   date       : word;
                   memo       : string[33];
                 end;
  string14     = string[14];

Var
  R                             : regpack;
  pointer,dta,fcb_addr          : mem_ptr;
  asciiz,filez                  : string[32];  {string input for dir scan}
  fname,volume                  : fname_type;
  bts                           : real;
  x, i, y, q, e, w, check_num,
  drv, crt_reg,
  cat_num, vol_num              : Integer;
  ok, done, found, changed      : Boolean;
  ch, ch2,ch1, default_drive,
  auto_load, cnf_drive          : Char;
  catfile                       : file of cat_type;
  one_memo                      : memo_type;
  cat_array                     : array [1..max_records] of cat_type;
  vol_array                     : array [1..100] of fname_type;
  temp_array                    : array [1..100] of temp_type;
  catname                       : string[14];
  cnf                           : text;
  dta_area                      : array [1..130] of byte;
  fcb                           : array [-7..36] of char;
  temp                          : string[11];
  z, t4, t1, t2, t3, vol_min, vol_max  : integer;

{---------------------  Procedures  -----------------------------}
procedure set_fcb; forward;

procedure keycontinue;
var
  ch : char;
  x  : integer;
begin
  write (' Tap any key for more ');
  read (kbd,ch);
  for x := 1 to 22 do write (chr(8));
  clreol;
end;

procedure screen_off;
begin
  crt_reg := $c;
  port[$3d4] := crt_reg;
  z := port[$3d5];
  port[$3d4] := crt_reg;
  port[$3d5] := $8;
end;

procedure screen_on;
begin
  port[$3d4] := crt_reg;
  port[$3d5] := z;
end;

procedure log_new_drive(ch:char);
begin
  drv := ord(ch) - ord('A');
  r.dx := drv;
  r.ax := $e shl 8;            { Log a new drive as the default }
  msdos(R);
end;

procedure read_config;
begin
  assign (cnf , 'pc-disk.cnf');
  {$I-}
  reset (cnf);
  {$I+}
  ok := (ioresult = 0);
  if ok then
    begin
      readln (cnf, default_drive);
      readln (cnf, catname);
      readln (cnf, auto_load);
      readln (cnf, cnf_drive);
      close (cnf);
    end
  else
    begin
      catname := 'Catalog.Dat';
      default_drive := 'A';
      auto_load := 'Y';
      cnf_drive := 'B';
    end;
  drv := ord(default_drive) - ord('A');
  r.dx := drv;
  r.ax := $e shl 8;            { Log cnf drive as the default }
  msdos(R);
end;

Procedure drawbox_ibm (x1,y1,x2,y2,FG,BG : Integer; boxname : names; blnk : boolean);
Begin
  window (x1,y1,x2,y1+1);
  textbackground(BG);
  GotoXY(1,1);
  x := x2-x1;
  if length(boxname) > x then boxname[0] := chr(x-4);
  textcolor(FG);
  Write('╒');
  if blnk then textcolor(FG + blink) else textcolor(fg);
  write (boxname);
  textcolor(FG);
  for q := x1+length(boxname)+1 to x2-1 do Write('═');
  Write('╕');
  for q := 2 to y2-y1 do
    Begin
      window (x1,y1,x2,y1+q+1);
      GotoXY(1,q); Write('│');
      if blnk then clreol;
      GotoXY(x2-x1+1,q); Write('│');
    end;
  Window(x1,y1,x2,y2+1);
  gotoXY(1,y2-y1+1);
  Write('╘');
  for q := x1+1 to x2-1 do Write('═');
  Write('╛');
end;

Procedure drawbox (x1,y1,x2,y2,FG,BG : Integer; boxname : Names; blnk : boolean);
Begin
  Drawbox_IBM (x1,y1,x2,y2,FG,BG,boxname,blnk);
  Window (x1+1,y1+1,x2-1,y2-1);
  Clrscr;
end;

procedure write_config(default_drive, auto_load, cnf_drive:char; catname:string14);
begin
  write ('     Saving to ',cnf_drive + ':PC-Disk.Cnf . One moment please..');
  assign (cnf, cnf_drive + ':PC-Disk.cnf');
  rewrite (cnf);
  writeln (cnf, default_drive);
  writeln (cnf, catname);
  writeln (cnf, auto_load);
  writeln (cnf, cnf_drive);
  close (cnf);
end;

procedure load_catalog;
begin
  cat_num := 0;
  drawbox (40,15,78,23,lightcyan,black,'[ Catalog Load ]',blink_no);
  writeln;
  writeln ('Loading from file ',catname);
  set_fcb;
  assign (catfile, catname);
  {$I-}
  reset (catfile);
  {$I+}
  ok := (ioresult=0);
  if not ok then
    begin
      rewrite (catfile);
      writeln ('File not found, Creating a new one. ');
    end
  else
    begin
      cat_num := 0;
      vol_num := 0;
      while (not eof(catfile)) and (cat_num < max_records + 1) do
        begin
          cat_num := cat_num + 1;
          read (catfile, cat_array[cat_num]);
          if cat_array[cat_num].vol_record > vol_num then
            begin
              writeln ('Invalid record found and discarded.');
              cat_num := cat_num - 1;
            end
          else
            if cat_array[cat_num].vol_record = -1 then   { vol label record }
              begin
                vol_num := vol_num + 1;
                vol_array[vol_num] := cat_array[cat_num].fil;
              end;
        end;
      writeln;
      writeln (cat_num,' file entries loaded, ',max_records - cat_num,' empty.');
      writeln (vol_num,' volume entries loaded, ',100-vol_num,' empty.');
    end;
  close (catfile);
end;

procedure save_catalog;
begin
  drawbox (40,15,78,23,lightcyan,black,'[ Catalog Save ]',blink_no);
  writeln;
  writeln ('Saving to file ',catname);
  set_fcb;
  close (catfile);
  assign (catfile, catname);
  rewrite (catfile);
  x := 0;
  if cat_num = 0 then
    writeln ('No entries to save, aborted.')
  else
    begin
      while x < cat_num do
        begin
          x := x + 1;
          write (catfile, cat_array[x]);
        end;
    end;
  close (catfile);
  writeln;
  writeln (x,' entries saved, ',max_records-x,' empty.');
  changed := false;
end;

Procedure big_exit;
begin
  if changed then
    begin
      drawbox (20,10,60,16,white,red,'[ Warning! ]',blink_yes);
      writeln;
      writeln ('Catalog has been changed and not Saved!');
      write ('Do you want to Save [Y/N] ? ');
      repeat read (kbd,ch); until ch in yes_no;
      if upcase(ch) = 'Y' then
        save_catalog;
    end;
  textbackground(black);
  textcolor(yellow);
  window (1,1,80,25);
  for x := 10 downto 1 do
    for y := 2 downto 1 do
      begin
        window (x+y-1,x+4,82-x-y,25-x);
        clrscr;
        delay (5);
      end;
  gotoxy (29,12);
  write ('PC-Disk has Completed.');
  halt;
end;

procedure configure;
var
  temp_drive, temp_load, temp_cnf : char;
  temp_catname : string14;
begin
  drawbox (4,6,77,24,lightblue,black,'[ Configuration ]',blink_no);
  writeln;
  writeln ('  Current defaults:');
  writeln;
  gotoxy (5,4); write ('Data Drive [A-F]   > ',default_drive);
  gotoxy (5,6); write ('Catalog Filename   > ',catname);
  gotoxy (61,6);write ('see note 1');
  gotoxy (5,8); write ('Auto Load  [Y/N]   > ',auto_load);
  gotoxy (5,10);write ('Config Drive [A-F] > ',cnf_drive);
  textcolor (lightgreen);
  gotoxy (5,16); writeln ('Note 1 - Please include drive specifier when entering the filename');
                 write   ('             so the catalog file will always reside on the same drive.');
  textcolor (lightcyan);
  gotoxy (28,4); repeat
                   read (kbd,temp_drive);
                   temp_drive := upcase(temp_drive);
                 until temp_drive in ['A'..'F',#13];
                 write (temp_drive);
                 if temp_drive = #13 then temp_drive := default_drive;
  gotoxy (42,6); buflen := 14; readln (temp_catname);
                 if temp_catname = '' then temp_catname := catname;
  gotoxy (28,8); repeat
                   read (kbd,temp_load);
                   temp_load := upcase(temp_load);
                 until temp_load in ['Y','N',#13];
                 write (temp_load);
                 if temp_load = #13 then temp_load := auto_load;
  gotoxy (28,10); repeat
                    read (kbd,temp_cnf);
                    temp_cnf := upcase(temp_cnf);
                  until temp_cnf in ['A'..'F',#13];
                  write (temp_cnf);
                  if temp_cnf = #13 then temp_cnf := cnf_drive;
  gotoxy (5,12); write (' Save to Configuration file ? ');
                 repeat
                   read (kbd,ch);
                 until ch in yes_no;
                 writeln (ch);
  if upcase(ch) = 'Y' then
    write_config(temp_drive, temp_load, temp_cnf, temp_catname);
  log_new_drive(temp_drive);
  default_drive := temp_drive;
  cnf_drive := temp_cnf;
  auto_load := temp_load;
  catname := temp_catname;
end;

procedure set_dta;
begin
{-- Set DTA address --}
  pointer := addr(dta_area);
  r.ds := seg(pointer^);
  r.dx := ofs(pointer^);
  r.ax := $1A shl 8;
  MsDos(R);
end;

procedure get_dta;
begin
{-- Get DTA address in ES:BX --}
  r.ax := 0;
  r.es := 0;
  r.bx := 0;
  r.ax := $2F shl 8;
  MsDos(R);
  dta := ptr(r.es,r.bx);
end;

procedure set_fcb;
begin
{-- Set up an unopened FCB --}
  for x := -7 to 36 do fcb[x] := #0;
  fcb[-7] := #255;
  fcb[-1] := #0;
  filez := '*.*' + #0;
  pointer := addr(filez[1]);
  r.ds := seg(pointer^);
  r.si := ofs(pointer^);
  pointer := addr(fcb[0]);
  r.es := seg(pointer^);
  r.di := ofs(pointer^);
  r.ax := $29 shl 8;
  msdos(R);
  set_dta;
  get_dta;
end;

procedure msdos12;
begin
  set_dta;
  pointer := addr(fcb[-7]);
  r.ds := seg(pointer^);
  r.dx := ofs(pointer^);
  r.ax := $12 shl 8;         { go after the next matching entry }
  msdos(R);
end;

procedure msdos11(x : integer);
begin
  set_fcb;
  fcb[-7] := #255;
  fcb[-1] := chr(x);
  pointer := addr(fcb[-7]);
  r.ds := seg(pointer^);
  r.dx := ofs(pointer^);
  r.ax := $11 shl 8;
  msdos(R);
end;

Procedure init;
Begin
  screen_off;
  done := False;
  changed := false;
  cat_num := 0;
  vol_num := 0;
  drv := 0;
  Window (1,1,80,25);
  ClrScr;
  drawbox(1,1,80,13,green,black,'',blink_no);
  textcolor(yellow);
  writeln (' PC-Disk represents many long hours of work.  Please help fight the high');
  writeln (' cost of computer software by supporting the  FREEWARE  concept. If you');
  writeln (' find this program of value, a small contribution of $35 would be greatly');
  writeln (' appreciated.  In any case, please share this program with others.  No other');
  writeln (' retribution may be accepted for PC-Disk except by The Forbin Project.');
  writeln (' Send all comments and contributions to:');
  writeln ('                           The Forbin Project');
  writeln ('                           c/o John Friel III');
  writeln ('                           715 Walnut Street');
  writeln ('                           Cedar Falls, Iowa  50613');
  write   ('           PC-Disk (c) The Forbin Project and John Friel III');
  gotoxy (1,1);
  screen_on;
  read (kbd,ch);
end;

procedure show_dta(x1,y1 : integer);
var
 t1,t2,d1,d2,hour,minutes,seconds,dd,mm,yy : integer;
 bytes : real;
begin
  for x := 8 to 15 do
    write(chr(mem[x1:y1+x]));
  write (' ');
  for x := 16 to 18 do
    write(chr(mem[x1:y1+x]));
  write (' ');
  t1 := mem[x1:y1+30];
  t2 := mem[x1:y1+31];
  d1 := mem[x1:y1+32];
  d2 := mem[x1:y1+33];
  bytes := mem[x1:y1+37]*256.0;
  bytes := bytes + mem[x1:y1+36];
  bytes := bytes + mem[x1:y1+38] * 65536.0;
  write (bytes:6:0,' ');
  hour := (t2 and 249) shr 3;
  if hour > 12 then hour := hour - 12;
  minutes := ((t2 and 7) shl 3) + ((t1 and 224) shr 5);
  write (hour:2,':');
  if minutes < 10 then write ('0');
  write (minutes);
  mm := ((d2 and 1) shl 3) + ((d1 and 224) shr 5);
  dd := (d1 and 31);
  yy := 80 + ((d2 and 255) shr 1);
  write ('  ');
  if mm < 10 then write ('0'); write (mm,'-');
  if dd < 10 then write ('0'); write (dd,'-');
  write (yy:2);
end;

function free_space(drive_letter : char) : integer;
var
  dl : integer;
begin
  drive_letter := upcase(drive_letter);
  case drive_letter of
    'A'..'E'  : dl := ord(drive_letter)-ord('A')+1;
  else
    dl := 0;
  end;
  r.ax :=$36 shl 8;          { disk free space }
  r.dx := dl;
  MsDos(R);
  free_space := r.bx  { r.bx is the free space in Kbytes }
end;

procedure get_vol;
begin
  volume := '';
  msdos11(8);
  if (r.ax and 255) = 0 then
    begin
      for x := 8 to 18 do
        volume := volume + chr(mem[seg(dta^):ofs(dta^)+x]);
      writeln ('Volume is ',volume);
    end
  else
    writeln ('Disk has no Volume Label!  Aborted.');
end;

procedure dir2;
var
  x : integer;
  bytes : real;
begin
  drawbox (1,5,39,24,white,black,'[ Dir ]',blink_yes);
  textcolor(lightgray);
  x := 2;
  writeln ('Place disk in drive ',default_drive);
  write (' and press any key ');
  read (kbd,ch);
  writeln;
  get_vol;
  writeln;
  set_fcb;
  msdos11(3);
  if (r.ax and 255) = 0 then
    begin
      while (r.ax and 255) = 0 do
        begin
          x := x + 1;
          write (' ');
          show_dta (seg(dta^),ofs(dta^));
          writeln;
          if x/17 = int(x/17) then keycontinue;
          msdos12;
        end
    end
  else
    writeln ('Disk is Empty!');
  bytes := free_space(default_drive) * 1024.0;
  writeln ('    Free space = ',bytes:6:0,' bytes');
  write ('Press any key to continue');
  read (kbd,ch);
end;

procedure update_disk;
begin
  drawbox (10,7,70,24,white,black,'[ Update Disk ]',blink_no);
  found := false;
  writeln;
  writeln ('Place disk in drive ',default_drive,' and press any key...');
  read (kbd,ch);
  volume := '';
  get_vol;
  if volume <> '' then
    begin
      {scan the catalog for volume}
      writeln;
      changed := true;
      for x := 1 to vol_num do
        begin
        if vol_array[x] = volume then
          begin
            found := true;
            t1 := x;
            t4 := x;
          end;
        end;
      if found then  { Do a selective update/delete function }
        begin
          writeln ('Disk is already cataloged, performing update.');
          writeln;
          vol_min := 0;
          vol_max := 0;
          t2 := 0;  { count files found on disk }
          for x := 1 to cat_num  do
            if (cat_array[x].vol_record = t1) and (vol_min = 0) then
              vol_min := x
            else
              if (vol_min <> 0 ) and (vol_max = 0) and (cat_array[x].vol_record <> t1) then
                vol_max := x - 1 ;
          if vol_max = 0 then vol_max := cat_num;
          msdos11(3);
          if (r.ax and 255) = 0 then
            begin
              while (r.ax and 255) = 0 do
                begin {q1}
                  t2 := t2 + 1;
                  temp := '';
                  for x := 8 to 18 do
                    temp := temp + chr(mem[seg(dta^):ofs(dta^)+x]);
                  temp_array[t2].fil := temp;
                  temp_array[t2].sizelo[1] := chr(mem[seg(dta^):ofs(dta^)+36]);
                  temp_array[t2].sizelo[2] := chr(mem[seg(dta^):ofs(dta^)+37]);
                  temp_array[t2].sizehi[1] := chr(mem[seg(dta^):ofs(dta^)+38]);
                  temp_array[t2].sizehi[2] := chr(mem[seg(dta^):ofs(dta^)+39]);
                  temp_array[t2].time[1] := chr(mem[seg(dta^):ofs(dta^)+30]);
                  temp_array[t2].time[2] := chr(mem[seg(dta^):ofs(dta^)+31]);
                  temp_array[t2].date[1] := chr(mem[seg(dta^):ofs(dta^)+32]);
                  temp_array[t2].date[2] := chr(mem[seg(dta^):ofs(dta^)+33]);
                  {-- now find old entry if any --}
                  found := false;
                  for x := vol_min to vol_max do
                    begin
                      if cat_array[x].fil = temp then
                        begin
                          found := true;
                          t3 := x;
                        end;
                    end;
                  if not found then
                    begin
                      write (temp,'  ');
                      write (' New Memo > ');
                      buflen := 33;
                      readln (one_memo);
                      temp_array[t2].memo := one_memo;
                    end
                  else
                    begin
                      writeln (temp,'   Memo > ',cat_array[t3].memo);
                      write ('Replace [Y/N] ? ');
                      repeat read (kbd,ch); until ch in yes_no;
                      if upcase(ch) = 'Y' then
                        begin
                          for q := 1 to 16 do write (chr(8)); clreol;
                          write (' New memo > ');
                          buflen := 33;
                          readln (one_memo);
                          temp_array[t2].memo := one_memo;
                        end
                      else
                        begin
                          for q := 1 to 16 do write (chr(8)); clreol;
                          temp_array[t2].memo := cat_array[t3].memo;
                        end;
                    end;
                  msdos12;
                end
            end;
          writeln ('Updating catalog..  One moment...');
          t1 := vol_max - vol_min + 1;
          if t1 < t2 then
            begin
              {check to see if we will overrun the array}
              if (cat_num + (t2 - t1)) > max_records then
                begin
                  writeln ('Maximum of ',max_records,' files exceeded by ',cat_num + t2 - t1 - max_records,'.');
                  writeln ('Truncating to ',max_records);
                end;
              {move the file up t2 - t1 records}
              for x := (cat_num + t2 - t1) downto (vol_max + t2-t1 + 1) do
                cat_array[x] := cat_array[x - t2+t1];
              cat_num := cat_num + t2 - t1;
              {insert temp array}
              for x := 1 to t2 do
                begin
                  cat_array[x + vol_min - 1].fil := temp_array[x].fil;
                  cat_array[x + vol_min - 1].sizelo := temp_array[x].sizelo;
                  cat_array[x + vol_min - 1].sizehi := temp_array[x].sizehi;
                  cat_array[x + vol_min - 1].time := temp_array[x].time;
                  cat_array[x + vol_min - 1].date := temp_array[x].date;
                  cat_array[x + vol_min - 1].memo := temp_array[x].memo;
                  cat_array[x + vol_min - 1].vol_record := t4;
                end;
            end
          else  {the temp will fil in the old slot}
            if t1 > t2 then
              begin
                {insert temp array at vol_min}
                for x := 1 to t2 do
                  begin
                    cat_array[x + vol_min - 1].fil := temp_array[x].fil;
                    cat_array[x + vol_min - 1].sizelo := temp_array[x].sizelo;
                    cat_array[x + vol_min - 1].sizehi := temp_array[x].sizehi;
                    cat_array[x + vol_min - 1].time := temp_array[x].time;
                    cat_array[x + vol_min - 1].date := temp_array[x].date;
                    cat_array[x + vol_min - 1].memo := temp_array[x].memo;
                    cat_array[x + vol_min - 1].vol_record := t4;
                  end;
                { move the array down to meet it }
                for x := (vol_max + t2-t1 + 1) to (cat_num + t2 - t1) do
                  cat_array[x] := cat_array[x -(t2-t1)];
                cat_num := x;
              end
            else  { the replacement array is an exact match !}
              for x := 1 to t2 do
                begin
                  cat_array[x + vol_min - 1].fil := temp_array[x].fil;
                  cat_array[x + vol_min - 1].sizelo := temp_array[x].sizelo;
                  cat_array[x + vol_min - 1].sizehi := temp_array[x].sizehi;
                  cat_array[x + vol_min - 1].time := temp_array[x].time;
                  cat_array[x + vol_min - 1].date := temp_array[x].date;
                  cat_array[x + vol_min - 1].memo := temp_array[x].memo;
                  cat_array[x + vol_min - 1].vol_record := t4;
                end;
        end
      else           { Do a Complete Add function }
        begin
          msdos11(3);
          if (r.ax and 255) = 0 then
            begin
              cat_num := cat_num + 1;
              vol_num := vol_num + 1;
              vol_array[vol_num] := volume;
              cat_array[cat_num].vol_record := -1;  { -1 means this is a vol entry }
              cat_array[cat_num].fil := volume;
              cat_array[cat_num].memo := 'Volume Label';
              while ((r.ax and 255) = 0) and (cat_num < max_records + 1) do
                begin
                  cat_num := cat_num + 1;
                  temp := '';
                  for x := 8 to 18 do
                    temp := temp + chr(mem[seg(dta^):ofs(dta^)+x]);
                  write (temp,'  ');
                  write (' Memo > ');
                  buflen := 33;
                  readln (one_memo);
                  cat_array[cat_num].vol_record := vol_num;
                  cat_array[cat_num].fil := temp;
                  cat_array[cat_num].sizelo[1] := chr(mem[seg(dta^):ofs(dta^)+36]);
                  cat_array[cat_num].sizelo[2] := chr(mem[seg(dta^):ofs(dta^)+37]);
                  cat_array[cat_num].sizehi[1] := chr(mem[seg(dta^):ofs(dta^)+38]);
                  cat_array[cat_num].sizehi[2] := chr(mem[seg(dta^):ofs(dta^)+39]);
                  cat_array[cat_num].time[1] := chr(mem[seg(dta^):ofs(dta^)+30]);
                  cat_array[cat_num].time[2] := chr(mem[seg(dta^):ofs(dta^)+31]);
                  cat_array[cat_num].date[1] := chr(mem[seg(dta^):ofs(dta^)+32]);
                  cat_array[cat_num].date[2] := chr(mem[seg(dta^):ofs(dta^)+33]);
                  cat_array[cat_num].memo := one_memo;
                  msdos12;
                end;
            end
          else
            writeln ('Disk has no files!');
        end;
      if cat_num = max_records then writeln ('The catalog is full.');
    end
  else
    begin
      writeln (' Cannot catalog a disk without a Volume Label.');
      writeln (' Use funtion 7 on the Main Menu to add a Volume Label.');
    end;
  write ('Press any key to continue');
  read (kbd,ch);
end;

function upcase33(strng : memo_type) : memo_type;
var
  temp : memo_type;
  x : integer;
begin
  temp := '';
  for x := 1 to length(strng) do
    temp := temp + upcase(strng[x]);
  upcase33 := temp;
end;

procedure scan_comments;
var
  scanner : string[33];
  bytes : real;
  t1,t2,d1,d2,hour,minutes,mm,dd,yy,y : integer;
begin
  drawbox (7,6,60,10,lightcyan,black,'[ Scan Memos ]',blink_no);
  y := 0;
  writeln ('Enter string to scan for  [1-33 characters]');
  writeln ('_________________________________');
  gotoxy (1,2);
  buflen := 33;
  readln (scanner);
  drawbox (1,1,80,24,cyan,black,
  '[Vol Label] [Filename ] [Size] [Tm] [ Date ] [------------  Memo  -----------]',blink_no);
  scanner := upcase33(scanner);
  for x := 1 to cat_num do
    if cat_array[x].vol_record = -1 then
      volume := cat_array[x].fil
    else
      begin
      if pos(scanner, upcase33(cat_array[x].memo)) > 0 then
        begin
          y := y + 1;
          write (volume:11);
          write (' ',cat_array[x].fil:11);
          bytes := ord(cat_array[x].sizelo[2]) * 256.0;
          bytes := bytes + ord(cat_array[x].sizelo[1]);
          bytes := bytes + ord(cat_array[x].sizehi[1]) * 65536.0;
          write (' ',bytes:6:0);
          t1 := ord(cat_array[x].time[1]);
          t2 := ord(cat_array[x].time[2]);
          d1 := ord(cat_array[x].date[1]);
          d2 := ord(cat_array[x].date[2]);
          hour := (t2 and 249) shr 3;
          if hour = 0 then
            write (' 00')
          else
            if hour < 10 then
              write (' 0',hour)
            else
              write (' ',hour);
          minutes := ((t2 and 7) shl 3) + ((t1 and 224) shr 5);
          if minutes < 10 then write ('0');
          write (minutes);
          mm := ((d2 and 1) shl 3) + ((d1 and 224) shr 5);
          dd := (d1 and 31);
          yy := 80 + ((d2 and 255) shr 1);
          write (' ');
          if mm < 10 then write ('0'); write (mm,'-');
          if dd < 10 then write ('0'); write (dd,'-');
          write (yy:2);
          write (' ',cat_array[x].memo);
          if length(cat_array[x].memo) < 33 then writeln;
          if y/21 = int(y/21) then keycontinue;
        end;
      end;
  writeln;
  write ('End of catalog. Press any key to continue');
  read (kbd,ch);
end;

function upcase11(strng : fname_type) : fname_type;
var
  temp : fname_type;
  x : integer;
begin
  temp := '';
  for x := 1 to length(strng) do
    temp := temp + upcase(strng[x]);
  upcase11 := temp;
end;

procedure scan_files;
var
  scanner : string[11];
  bytes : real;
  t1,t2,d1,d2,hour,minutes,mm,dd,yy,y: integer;
begin
  drawbox (7,6,60,10,lightcyan,black,'[ Scan Filenames ]',blink_no);
  y := 0;
  writeln ('Enter string to scan for  [1-11 characters]');
  writeln ('___________');
  gotoxy (1,2);
  buflen := 11;
  readln (scanner);
  drawbox (1,1,80,24,cyan,black,
  '[Vol Label] [Filename ] [Size] [Tm] [ Date ] [------------  Memo  -----------]',blink_no);
  scanner := upcase11(scanner);
  for x := 1 to cat_num do
    if cat_array[x].vol_record = -1 then
      volume := cat_array[x].fil
    else
      begin
      if pos(scanner, upcase11(cat_array[x].fil)) > 0 then
        begin
          y := y + 1;
          write (volume:11);
          write (' ',cat_array[x].fil:11);
          bytes := ord(cat_array[x].sizelo[2]) * 256.0;
          bytes := bytes + ord(cat_array[x].sizelo[1]);
          bytes := bytes + ord(cat_array[x].sizehi[1]) * 65536.0;
          write (' ',bytes:6:0);
          t1 := ord(cat_array[x].time[1]);
          t2 := ord(cat_array[x].time[2]);
          d1 := ord(cat_array[x].date[1]);
          d2 := ord(cat_array[x].date[2]);
          hour := (t2 and 249) shr 3;
          if hour = 0 then
            write (' 00')
          else
            if hour < 10 then
              write (' 0',hour)
            else
              write (' ',hour);
          minutes := ((t2 and 7) shl 3) + ((t1 and 224) shr 5);
          if minutes < 10 then write ('0');
          write (minutes);
          mm := ((d2 and 1) shl 3) + ((d1 and 224) shr 5);
          dd := (d1 and 31);
          yy := 80 + ((d2 and 255) shr 1);
          write (' ');
          if mm < 10 then write ('0'); write (mm,'-');
          if dd < 10 then write ('0'); write (dd,'-');
          write (yy:2);
          write (' ',cat_array[x].memo);
          if length(cat_array[x].memo) < 33 then writeln;
          if y/21 = int(y/21) then keycontinue;
        end;
      end;
  writeln;
  write ('End of catalog. Press any key to continue');
  read (kbd,ch);
end;

procedure vol_disk;
var
  newvol : fname_type;
begin
  drawbox (3,15,55,20,lightgreen,black,'[ Volume Disk ]',blink_no);
  volume := '';
  msdos11(8);
  if (r.ax and 255) = 0 then
    begin
      for x := 8 to 18 do
        volume := volume + chr(mem[seg(dta^):ofs(dta^)+x]);
      writeln ('Current Volume is ',volume);
      write ('Are you sure you want to change ? ');
      repeat read (kbd,ch); until ch in yes_no;
      if upcase(ch) = 'Y' then
        begin
          writeln;
          write ('Enter new Volume Label >');
          buflen := 11;
          readln (newvol);
          for x := length(newvol) to 11 do newvol := newvol + ' ';
          for x := 17 to 28 do fcb[x] := newvol[x-16];
          pointer := addr(fcb[-7]);
          r.ds := seg(pointer^);
          r.dx := ofs(pointer^);
          r.ax := $17 shl 8;
          msdos(R);
        end
    end
  else
    begin
      write ('Enter new Volume Label >');
      buflen := 11;
      readln (newvol);
      for x := length(newvol) to 11 do newvol := newvol + ' ';
      for x := 1 to 11 do fcb[x] := newvol[x];
      pointer := addr(fcb[-7]);
      r.ds := seg(pointer^);
      r.dx := ofs(pointer^);
      r.ax := $16 shl 8;
      msdos(R);
    end;
end;

procedure scan_submenu;
begin
  drawbox(1,5,80,9,lightred,black,'[ Scan Sub-Menu ]',blink_no);
  writeln ;
  write ('  1) Filenames   2) Memos   3) Exit   Your choice ? ');
  repeat
    read (kbd,ch);
  until ch in ['1'..'3'];
  case ch of
    '1' : scan_files;
    '2' : scan_comments;
  end;
end;

procedure delete_volume;
var
  vnum : integer;
begin
  drawbox (2,5,78,24,white,black,'[ Delete Volume ]',blink_yes);
  writeln (' Select the volume to be deleted by entering the number');
  writeln (' associated with the Volume Label.');
  for x := 1 to vol_num do
    write (' ',x:2,')',vol_array[x]:11);
  writeln;
  repeat
    write ('Enter volume number :');
    readln (vnum);
  until (vnum > 0) and (vnum <= vol_num);
  writeln;
  write ('Delete volume ',vol_array[vnum],' [Y/N] ? ');
  repeat read (kbd,ch); until ch in yes_no;
  if upcase(ch) = 'Y' then
    begin
      writeln ('Deleting volume ',vol_array[vnum]);
      vol_min := 0;
      vol_max := 0;
      t2 := 0;  { count files found on disk }
      for x := 1 to cat_num  do
        if (cat_array[x].vol_record = vnum) and (vol_min = 0) then
          vol_min := x - 1
        else
          if (vol_min <> 0 ) and (vol_max = 0) and (cat_array[x].vol_record <> vnum) then
            vol_max := x - 1 ;
      if vol_max = 0 then vol_max := cat_num;
      t1 := vol_max - vol_min + 1;
      for x := (vol_max + t2-t1 + 1) to (cat_num + t2 - t1) do
        cat_array[x] := cat_array[x -(t2-t1)];
      if vnum = vol_num then
        cat_num := vol_min - 1
      else
        cat_num := x;
      { now renumber the cat_array }
      vol_num := 0;
      for x := 1 to cat_num do
        begin
          if cat_array[x].vol_record = -1 then
            begin
              vol_num := vol_num + 1;
              vol_array[vol_num] := cat_array[x].fil;
            end
          else
            cat_array[x].vol_record := vol_num;
        end;
    end
  else
    writeln ('Aborted.');
  write (' Press any key to continue ');
  read(kbd,ch);
end;

procedure show_catalog;
begin
  drawbox (1,5,30,24,white,black,'show',blink_no);
  for x := 1 to cat_num do
   begin
    writeln (x,' ',cat_array[x].vol_record,' ',cat_array[x].fil);
    if x/17 = int(x/17) then keycontinue;
   end;
  read (kbd,ch);
end;

procedure Help_tutor;
begin
  drawbox (10,7,73,20,white,black,'[ Help Tutorial ]',blink_no);
  gotoxy (1,1);
  textcolor (white);
  writeln ('                  System Requirements');
  textcolor (lightcyan);
  writeln (' PC-Disk needs at least 128K of ram, DOS 2.0 or higher,');
  writeln (' and at least one disk drive.  Two drives or the use of');
  writeln (' a RamDrive is recommended.');
  writeln;
  keycontinue;
  clrscr;
  textcolor (white);
  writeln ('                     Load Catalog');
  textcolor (lightcyan);
  writeln (' This is used to load the catalog file into memory.  If');
  writeln (' you don''t have a catalog file, this will also create');
  writeln (' one for you.  It is a good idea to have the catalog');
  writeln (' loaded for you every time you start the program. ');
  writeln;
  keycontinue;
  clrscr;
  textcolor (white);
  writeln ('                       Disk Dir');
  textcolor (lightcyan);
  writeln (' This shows you the same information as if you issued');
  writeln (' a "DIR /P" command from the DOS prompt. One addition');
  writeln (' has been made.  PC-Disk asks you to place a disk in');
  writeln (' the default Data drive and press any key.  This way');
  writeln (' you can swap disks, get a "DIR" and never leave the');
  writeln (' program!  The default Data drive is set in the config-');
  writeln (' uration menu.');
  writeln;
  keycontinue;
  clrscr;
  textcolor (white);
  writeln ('                     Update Catalog');
  textcolor (lightcyan);
  writeln (' PC-Disk prompts you to put a disk in the Data drive and');
  writeln (' press any key.  It then checks to see if the disk had a');
  writeln (' Volume Label.  PC-Disk requires the disk to have one so');
  writeln (' you can reference your files by Volume name.  If the Label');
  writeln (' is found, it is displayed on the screen.  Then a check is');
  writeln (' made to see if you are updating the catalog or adding a ');
  writeln (' new disk.  Should the disk already be cataloged, each file');
  writeln (' is displayed with the previously entered memo and you are');
  writeln;
  keycontinue;
  clrscr;
  writeln (' asked if you want to replace the memo.  Answer "Y" or "N".');
  writeln (' If you answered "Y", you are then prompted for the new');
  writeln (' memo.  A "N" response goes to the next file on the disk.');
  writeln (' If the disk being updated is new to the catalog, every file');
  writeln (' will be displayed and you will be prompted by "Memo >" in');
  writeln (' which to enter a memo.  The memo field is optional, but ');
  writeln (' comes in handy when you want to use the scan feature of PC-');
  writeln (' Disk.  When all files have been replied to, PC-Disk then');
  writeln (' updates the catalog in MEMORY.');
  writeln;
  keycontinue;
  clrscr;
  textcolor (white);
  writeln ('                     Save Catalog');
  textcolor (lightcyan);
  writeln (' Does just what it implies.  It saves the catalog that is');
  writeln (' currently in memory to the catalog disk file.  If you make');
  writeln (' any changes to the catalog, you MUST save it before you');
  writeln (' exit or all the changes are lost.');
  writeln;
  keycontinue;
  clrscr;
  textcolor (white);
  writeln ('                     Scan Catalog');
  textcolor (lightcyan);
  writeln (' This option brings up a sub-menu that asks you which field');
  writeln (' you want to scan.  After selecting Filenames or Memos, an-');
  writeln (' other window opens up prompting for the scan string.  File');
  writeln (' names are stored without the "." between the name and the');
  writeln (' suffix, so don''t enter a "." when scanning filenames!  Now');
  writeln (' PC-Disk uses the whole screen to show all the matching ');
  writeln (' entries complete with the directory information and memos.');
  writeln;
  keycontinue;
  clrscr;
  textcolor (white);
  writeln ('                     Delete Volume');
  textcolor (lightcyan);
  writeln (' PC-Disk numbers all of the Volume Labels and asks you to');
  writeln (' choose which one you want to delete.  It then asks you');
  writeln (' again if you are sure you want to do this.  A response of');
  writeln (' "N" aborts the delete and you then return to the main ');
  writeln (' menu.  Should you delete the wrong volume, remember - you');
  writeln (' can reload the catalog from disk with option 1. (doing ');
  writeln (' this would also negate any updates not saved to disk');
  writeln (' during the current session... beware.)');
  writeln;
  keycontinue;
  clrscr;
  textcolor (white);
  writeln ('                 Add/Change Volume Label');
  textcolor (lightcyan);
  writeln (' This is so you can add or change a Volume Label on any');
  writeln (' disk.  PC-Disk requires a Volume Label for update.  If');
  writeln (' a disk is already labeled, the old label is shown and');
  writeln (' you are asked if you really want to re-label it.  If it');
  writeln (' is a disk without a label, you are prompted to enter the');
  writeln (' new label.  Viola! A labeled disk!');
  writeln;
  keycontinue;
  clrscr;
  textcolor (white);
  writeln ('                 Configuration');
  textcolor (lightcyan);
  writeln (' Four prompts here.  The first one is the Data Drive.  Its');
  writeln (' drive you want to use for swapping disks during updates.');
  writeln (' The second prompt is the Catalog Filename.  This can be');
  writeln (' any valid DOS filename.  Please include a drive specifier');
  writeln (' with it unless you have a one-disk system.  Third is the');
  writeln (' Auto Load prompt.  This tells PC-Disk wether or not to');
  writeln (' load the Catalog file automatically on start-up. And last');
  writeln (' is the drive to store this Configuration to.  It should');
  writeln (' be the same drive as this program is stored on.');
  writeln;
  keycontinue;
end;

procedure options;
begin
  repeat
    Drawbox (1,1,80,4,brown,black,'',blink_yes);
    textcolor(lightgreen);
    Writeln ('                          PC-Disk  Version 1.21 ');
    Write   ('               (c) The Forbin Project  23 September 1984');
    drawbox(1,5,80,15,yellow,black,'[ Main Menu ]',blink_no);
    writeln;
    writeln ('  Options:    0) Help Tutorial             5) Scan Catalog in Memory');
    writeln ('              1) Load Catalog from Disk    6) Delete Volume in Memory');
    writeln ('              2) Disk Dir                  7) Add/Change Volume Label');
    writeln ('              3) Update Catalog in Memory  8) Configuration');
    writeln ('              4) Save Catalog to Disk      9) Exit PC-Disk');
    writeln;
    write   ('                    Your choice ');
    gotoxy (33,8);
    repeat
      read (kbd,ch);
    until ch in ['0'..'9','-'];
    case ch of
      '0' :  Help_tutor;
      '1' :  Load_catalog;
      '2' :  dir2;
      '3' :  update_disk;
      '4' :  save_catalog;
      '5' :  scan_submenu;
      '6' :  delete_volume;
      '7' :  vol_disk;
      '8' :  configure;
      '9' :  big_exit;
      '-' :  show_catalog;
    end; { case }
  until done;
end;

begin
  read_config;
  init;
  if auto_load = 'Y' then load_catalog;
  options;
  halt;
end.